HOMEWORK 1

READING THE DATA

library(data.table)
library(dplyr)
library(tidyr)
library("plot3D")
library(corrplot)

MuskData <- fread(file="c:/Users/BAHADIR/Desktop/IE 582/HW 2/RCode/Musk1.csv", header=FALSE, sep="," , stringsAsFactors=TRUE)
MuskDataReduced <- MuskData[,3:168]

TASK 1: MULTIPLE INSTANCE LEARNING

PART A

I removed bag and class information from the data first. Below are the PCA evaulation of the ungrouped data using pairwise plots of first 3 dimensions. Then I made a 3D plot in order to understand if it is enough to seperate the classes using just 3 dimensions.

pca<-princomp(MuskDataReduced,cor=T)
par(mfrow=c(1,1))

plot(pca$scores[,1], pca$scores[,2], col=(MuskData[,V1]+1), pch=".",cex=7)

plot(pca$scores[,2], pca$scores[,3], col=(MuskData[,V1]+1), pch=".",cex=7)

plot(pca$scores[,1], pca$scores[,3], col=(MuskData[,V1]+1), pch=".",cex=7)

scatter3D(pca$scores[,1], pca$scores[,2], pca$scores[,3], col=(MuskData[,V1]+1), pch=".",cex=5, theta = 40, phi = -5)

If we look from a certain angle to the 3D plot, we can see there is a plane that seperates black dots from red dots. Below are the MDS calculation using 5 different distance measures.

distance <- dist(MuskDataReduced, method = "manhattan", diag = TRUE, upper = TRUE)
mds=cmdscale(distance)
plot(mds[,1],mds[,2],main='Manhattan', col=(MuskData[,V1]+1), pch=".",cex=7)

distance <- dist(MuskDataReduced, method = "minkowski", diag = TRUE, upper = TRUE , p=1.5)
mds=cmdscale(distance)
plot(mds[,1],mds[,2],main='Minkowski p=1.5', col=(MuskData[,V1]+1), pch=".",cex=7)

distance <- dist(MuskDataReduced, method = "euclidean", diag = TRUE, upper = TRUE)
mds=cmdscale(distance)
plot(mds[,1],mds[,2],main='Euclidean', col=(MuskData[,V1]+1), pch=".",cex=7)

distance <- dist(MuskDataReduced, method = "minkowski", diag = TRUE, upper = TRUE , p=3)
mds=cmdscale(distance)
plot(mds[,1],mds[,2],main='Minkowski p=3', col=(MuskData[,V1]+1), pch=".",cex=7)

distance <- dist(MuskDataReduced, method = "maximum", diag = TRUE, upper = TRUE)
mds=cmdscale(distance)
plot(mds[,1],mds[,2],main='Maximum', col=(MuskData[,V1]+1), pch=".",cex=7)

We can see all MDS calculations give different results. It is important to note that MDS that uses euclidean distances is very close in terms of seperation to PCA that uses first two dimensions.

PART B

Bags are summarizes using feature means as expected. However due to PCA being a linear algorithm and we have less bags than number of features, we need to eliminate a number of features. In order to do that, I first plot the correlation matrix, where blue dots represent close to 1 correlation between features.

MuskDataCombined <- as.data.frame(MuskData[, lapply(.SD, mean),by = V2])
MuskDataCombinedReduced <- MuskDataCombined[,3:168]


corrplot(cor(MuskDataCombinedReduced), type = "upper", order = "hclust", tl.col = "black", tl.srt = 45)

corrMatrix <- cor(MuskDataCombinedReduced)
corrMatrix[upper.tri(corrMatrix)] <- 0
diag(corrMatrix) <- 0

After I saw many groupings of variables having very high negative or positive correlation, I decided to use only the variables having less than 0.95 absolute correlation. The same diagrams are drawn as in part A for this question. I observed exactly the same thing as in ungrouped bags. I say taking means and disregarding some variables based on correlation was a good idea for classifying bags.

data.new <- MuskDataCombinedReduced[,!apply(corrMatrix,2,function(x) any(abs(x) > 0.95))]

pca<-princomp(data.new,cor=T)

plot(pca$scores[,1], pca$scores[,2], col=(MuskDataCombined[,'V1']+1), pch=".",cex=7)

plot(pca$scores[,2], pca$scores[,3], col=(MuskDataCombined[,'V1']+1), pch=".",cex=7)

plot(pca$scores[,1], pca$scores[,3], col=(MuskDataCombined[,'V1']+1), pch=".",cex=7)

scatter3D(pca$scores[,1], pca$scores[,2], pca$scores[,3], col=(MuskDataCombined[,'V1']+1), pch=".",cex=5, theta = 40, phi = -5)

distance <- dist(MuskDataCombinedReduced, method = "manhattan", diag = TRUE, upper = TRUE)
mds=cmdscale(distance)
plot(mds[,1],mds[,2],main='Manhattan', col=(MuskDataCombined[,'V1']+1), pch=".",cex=7)

distance <- dist(MuskDataCombinedReduced, method = "minkowski", diag = TRUE, upper = TRUE , p=1.5)
mds=cmdscale(distance)
plot(mds[,1],mds[,2],main='Minkowski p=1.5', col=(MuskDataCombined[,'V1']+1), pch=".",cex=7)

distance <- dist(MuskDataCombinedReduced, method = "euclidean", diag = TRUE, upper = TRUE)
mds=cmdscale(distance)
plot(mds[,1],mds[,2],main='Euclidean', col=(MuskDataCombined[,'V1']+1), pch=".",cex=7)

distance <- dist(MuskDataCombinedReduced, method = "minkowski", diag = TRUE, upper = TRUE , p=3)
mds=cmdscale(distance)
plot(mds[,1],mds[,2],main='Minkowski p=3', col=(MuskDataCombined[,'V1']+1), pch=".",cex=7)

distance <- dist(MuskDataCombinedReduced, method = "maximum", diag = TRUE, upper = TRUE)
mds=cmdscale(distance)
plot(mds[,1],mds[,2],main='Maximum', col=(MuskDataCombined[,'V1']+1), pch=".",cex=7)

PART C

In part B, I used the correlation matrix in order to reduce the number of features. The similar idea can be used in order to reduce the number of features further by reducing the number 0.95 to something like 0.8.

TASK 2: COMPRESS IMAGES USING PCA

PART 1

The image is read and displayed below as requested.

library(imager)
resim <- load.image("c:/Users/BAHADIR/Desktop/IE 582/HW 2/Picture.jpg")
str(resim)

##  'cimg' num [1:256, 1:256, 1, 1:3] 0.125 0.318 0.678 0.851 0.647 ...

par(mfrow=c(1,1))
plot(resim)

PART 2

The noise is added to the picture as requested. Also, different RGB channels are plotted as seen below.

RNoise <- replicate(256,runif(256,min(resim[,,1]),0.1*max(resim[,,1])))
GNoise <- replicate(256,runif(256,min(resim[,,2]),0.1*max(resim[,,2])))
BNoise <- replicate(256,runif(256,min(resim[,,3]),0.1*max(resim[,,3])))

noisyImage <- resim
noisyImage[,,1] <- (noisyImage[,,1] + RNoise)
noisyImage[,,2] <- (noisyImage[,,2] + GNoise)
noisyImage[,,3] <- (noisyImage[,,3] + BNoise)

noisyImage[,,1] <- ifelse(noisyImage[,,1] >1 , 1, noisyImage[,,1])
noisyImage[,,2] <- ifelse(noisyImage[,,2] >1 , 1, noisyImage[,,2])
noisyImage[,,3] <- ifelse(noisyImage[,,3] >1 , 1, noisyImage[,,3])

plot(noisyImage)

par(mfrow=c(1,3))
cscale <- function(r,g,b) rgb(r,0,0)
plot(noisyImage,colourscale=cscale,rescale=FALSE)
cscale <- function(r,g,b) rgb(0,g,0)
plot(noisyImage,colourscale=cscale,rescale=FALSE)
cscale <- function(r,g,b) rgb(0,0,b)
plot(noisyImage,colourscale=cscale,rescale=FALSE)

par(mfrow=c(1,1))

PART 3

Image with noise is converted to a greyscale image. Then 232 x 232 = 53824 patches are created. Then these patches are converted into a data frame having 53824 rows and 625 rows.

grayNoisyImage <- grayscale(noisyImage)
plot(grayNoisyImage)

patchesCoordX <- rep(seq(13,244,1),232)
patchesCoordY <- rep(seq(13,244,1),each = 232)
patches <- extract_patches(grayNoisyImage, patchesCoordX, patchesCoordY, 25, 25, boundary_conditions = 0L)
dataFrames <- as.data.frame(matrix(unlist(patches), nrow=length(patches), byrow=T))
dim(dataFrames)

## [1] 53824   625

PART 3A

Below are the results of PCA. The shapes present in the scores are reasonable since the patches close together highly depend on each other. The have 600 pixels in common for each subsequent patch. Only 25 pixels are different, pca showing some dependency and circle structures are understandable.

pca<-princomp(dataFrames,cor=T)
plot(pca$scores[,1], pca$scores[,2], pch=".",cex=1)

plot(pca$scores[,2], pca$scores[,3], pch=".",cex=1)

plot(pca$scores[,1], pca$scores[,3], pch=".",cex=1)

scatter3D(pca$scores[,1], pca$scores[,2], pca$scores[,3],pch=".",cex=1, theta = 55, phi = -5)

PART 3B

The results are somehow representing the image for each component. But they show a different subset of the picture if I may say so myself.

pca1Pic <- matrix(pca$scores[,1],nrow=232,ncol =232)
dim(pca1Pic)

## [1] 232 232

plot(as.cimg(pca1Pic))

pca2Pic <- matrix(pca$scores[,2],nrow=232,ncol =232)
plot(as.cimg(pca2Pic))

pca3Pic <- matrix(pca$scores[,3],nrow=232,ncol =232)
plot(as.cimg(pca3Pic))

PART 3C

Below we see the eigenvetors drawn as a patch as 25x25 picture. Based on the pictures, the first component shows mostly middle of the picture, second one shows the top and the last one shows the left of the picture.

pca1Pic <- matrix(pca$loadings[,1],nrow=25,ncol =25)
dim(pca1Pic)

## [1] 25 25

plot(as.cimg(pca1Pic))

pca2Pic <- matrix(pca$loadings[,2],nrow=25,ncol =25)
plot(as.cimg(pca2Pic))

pca3Pic <- matrix(pca$loadings[,3],nrow=25,ncol =25)
plot(as.cimg(pca3Pic))